home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Atari Forever 4
/
Atari Forever 4.zip
/
Atari Forever 4.iso
/
PD_THEMA
/
DENKSPIE
/
SCHIEBER
/
SCHIEBER.GFA
(
.txt
)
< prev
next >
Wrap
GFA-BASIC Atari
|
1986-02-05
|
19KB
|
952 lines
'
ON ERROR GOSUB gfa1
' ON BREAK GOSUB gfa2
ON BREAK CONT
HIDEM
DPOKE 9952,319
DPOKE 9954,199
STICK 1
'
SETCOLOR 0,0
SETCOLOR 15,7,7,7
DIM ss%(5)
DIM hi$(12)
DIM hi%(12)
'
RESTORE sdat1
FOR i%=1 TO 5
READ q1%
ss%(i%)=q1%
NEXT i%
' ---------------------------------------------------------------------
level%=1
life%=4
altlevel%=1
' ----------------------------------------------------------------------
GOSUB pic1
HIDEM
PRINT AT(9,7);
FORM INPUT 15 AS player$
IF player$=""
player$="niemando"
ENDIF
play$=" "
RSET play$=player$
play$=UPPER$(play$)
'
CLOSE #1
OPEN "R",#1,"A:\SCHIEBER\EINS.RAD",30
FIELD #1,15 AS n$,15 AS nn$
'
spieler_nr%=0
auweh%=0
'
FOR i%=1 TO 100
GET #1,i%
' --------------------
IF n$=" " AND auweh%=0 !LEERER EINTRAG
platz%=i%
auweh%=1
ENDIF
' --------------------
IF n$=play$
player$=n$
high%=VAL(nn$)
spieler_nr%=i%
ENDIF
EXIT IF spieler_nr%<>0
NEXT i%
CLOSE #1
'
' IN PLAYER$=SPIELERNAME
' IN HIGH%=DER HIGHSCORE
' SPIELER_NR%=DATENSATZNUMMER
IF spieler_nr%<>0
platz%=spieler_nr%
PRINT AT(18,22);high%
'
PRINT AT(9,14);
FORM INPUT 5 AS pass$
pass$=UPPER$(pass$)
IF pass$=""
GOTO fangneuan
ENDIF
' -------------------------------------------------------------------
' PASSTEST ZUR LEVELAUSWAHL
CLOSE #1
das%=0
OPEN "R",#1,"A:\SCHIEBER\ZWEI.RAD",5
FIELD #1,5 AS passy$
FOR i%=1 TO 100
GET #1,i%
IF passy$=pass$
level%=i%
altlevel%=level%
das%=1
ENDIF
EXIT IF das%=1
NEXT i%
CLOSE #1
' ---------------------------------------------------------------------
fangneuan:
'
ELSE
player$=play$
ENDIF
'
' ENDGÜLTIG DATENSATZNUMMER=PLATZ% ALLE SPEICHERVORGÄNGE DARÜBER
'
' ---------------------------
GOSUB pic2
PRINT AT(4,16);player$
PRINT AT(4,21);"HIGHSCORE ";high%
total%=188
IF level%<31
napf%=level%
ELSE
napf%=30
ENDIF
FOR i%=1 TO napf%
PBOX 224,total%-3,228,total%-1
SUB total%,4
NEXT i%
' ------------------------------------------
CLOSE #1
OPEN "I",#1,"A:\SCHIEBER\HIGH"
FOR i%=1 TO 12
INPUT #1,hi$(i%)
NEXT i%
FOR i%=1 TO 12
INPUT #1,q1%
hi%(i%)=q1%
NEXT i%
CLOSE #1
'
SGET screen$
' -------------------------------------------
'
SPUT screen$
' -------------------------------------------
GOSUB bilo
neueslevel:
anzeige%=1
STICK 1
GOSUB laden
bon%=100*(level%*2)
bon$=" "
RSET bon$=STR$(bon%)
PRINT AT(33,23);CHR$(27)+"c";+5;bon$;CHR$(27)+"c";0
'
' #################################################
start:
' -------------------------
ax%=15 !bildformat
ay%=13
' -----
m1%=7 !feld zum laufen
m2%=3 !kiste
m3%=4 !spielfigur
m5%=5 !WOHIN ??
' -------------------------
x%=1
y%=1
sx%=1
sy%=1
' -----
PUT 15,13,fahr$(2)
EVERY STOP
SETTIME "00:00:00","26.06.1988"
SLPOKE &H4BA,0
' PRINT AT(1,1);TIMER
zei$=""
EVERY 400 GOSUB zeit
REPEAT
UNTIL STRIG(1)=FALSE
'
haupt:
'
' PRINT AT(1,23);sx%;" ";sy%;" "
' -------------------------
PAUSE 5
' ------
GOSUB joy
' ------
IF TIMER>36000+(6000*level%)
EVERY STOP
FOR i%=1 TO 6
PRINT AT(33,4);CHR$(27)+"c";+2;zei$;" ";CHR$(27)+"c";0
PAUSE 20
PRINT AT(33,4);CHR$(27)+"c";+5;zei$;" ";CHR$(27)+"c";0
PAUSE 20
NEXT i%
feuer%=TRUE
ENDIF
'
IF feuer%=TRUE
GOSUB test
' -----
IF ohno%=0 !GESCHAFFT
EVERY STOP
d%=TIMER
d%=36000-d%
ADD score%,d% DIV 10
ADD score%,bon%
GOSUB sou1
GOSUB siege
GOTO neueslevel
ENDIF
' -----
IF life%>0
GOSUB sou1
RESTORE zu
FOR i%=1 TO life%
READ lx%,ly%
NEXT i%
DEFFILL 6
PBOX lx%,ly%,lx%+15,ly%+15
DEFFILL 7
PBOX lx%+2,ly%+2,lx%+13,ly%+13
DEC life%
GOSUB neues
GOTO start
ELSE
GOTO vorbei
ENDIF
' -----
IF x%<0 OR x%>20 OR y%<0 OR y%>15
GOTO haupt
ENDIF
' -----
ENDIF
' -------------------------
IF x%>sx%+1
GOTO haupt
ENDIF
' -----
IF x%<sx%-1
GOTO haupt
ENDIF
' -----
IF y%>sy%+1
GOTO haupt
ENDIF
' -----
IF y%<sy%-1
GOTO haupt
ENDIF
' -----
was%=f%(x%+1,y%+1)
' -----
SELECT was%
' PRINT AT(1,24);was%;"<<"
' -----
CASE 2,5,6,7
frei%=0
CASE 4
IF sy%=y%+1 OR sy%=y%-1
frei%=0
ELSE
frei%=1
ENDIF
DEFAULT
frei%=1
ENDSELECT
IF was%=2
SUB bon%,5
IF bon%<0
bon%=0
ENDIF
bon$=" "
RSET bon$=STR$(bon%)
PRINT AT(33,23);CHR$(27)+"c";+5;bon$;CHR$(27)+"c";0
ENDIF
' --------
' PRINT AT(33,7);frei%;" "
' -------------------------
IF frei%=0 !FELD FREI
PUT (sx%)*ax%,(sy%)*ay%,bil$(ff%(sx%+1,sy%+1))
' -----
PUT x%*ax%,y%*ay%,fahr$(fa%)
sx%=x%
sy%=y%
' FOR i%=1 TO 15 STEP 2
' gog%=RANDOM(5)+1
' d%=ss%(gog%)
SOUND 1,12,8,3 !3
PAUSE 1
SOUND 0,0,0,0,0
GOTO weiter4 !gelaufen
ENDIF
IF frei%=1 AND was%<>3
GOTO weiter4 !#####################
ENDIF
' -------------------------
zx%=x%+1 !FELDPOSITION
zy%=y%+1 !FELDPOSITION
' -----
' -----
IF sx%=x% !hoch runter
' -----
IF y%=sy%-1 !HOCH
GOSUB hoch
GOTO weiter3
ENDIF
' -----
IF y%=sy%+1 !RUNTER
GOSUB runter
GOTO weiter3
ENDIF
' -----
ENDIF
' -------------------------
' -------------------------
IF sy%=y% !LINKS RECHTS
' -----
IF x%=sx%-1 !LINKS
GOSUB links
GOTO weiter3
ENDIF
' -------------------------
IF x%=sx%+1 !RECHTS#######################################
GOSUB rechts
ENDIF
GOTO weiter3
ENDIF
' -----
weiter3:
SOUND 1,13,6,2
PAUSE 2
SOUND 0,0,0,0,0
weiter4:
' -----
GOTO haupt
' --------------------------
vorbei:
EVERY STOP
'
GOSUB pic3
'
'
STICK 0
GOSUB sort
'
PRINT AT(4,22);player$;" SCORE ";score%
IF hoch%=1
GOSUB high
hoch%=0
ENDIF
PAUSE 20
REPEAT
UNTIL STRIG(1)=TRUE
level%=altlevel%
score%=0
life%=4
SPUT screen$
GOTO neueslevel
'
STOP
GOSUB gfa2
' ---------------------------
' -------------------------
> PROCEDURE test
' -----
ohno%=0
zap%=0
' -----
FOR i%=1 TO fx%
FOR ii%=1 TO fy%
IF f%(i%,ii%)=m2% AND ff%(i%,ii%)<>m5% !KISTE WOHINFELD%
ohno%=1
ENDIF
IF f%(i%,ii%)=m2% AND ff%(i%,ii%)=m5% AND ohno%=0 !KISTE WOHINFELD%
INC zap%
ADD score%,(50*level%)*zap%
ENDIF
NEXT ii%
NEXT i%
' -----
RETURN
' -------------------------
> PROCEDURE maus(sc1%,sc2%,sc3%,sc4%,sc5%,sc6%)
' teiler x, teiler y,bereich <x >x bereich <y >y
'
PAUSE 20
SHOWM
'
mausin:
REPEAT
MOUSE x%,y%,k%
x%=x% DIV sc1%
y%=y% DIV sc2%
'
' PRINT AT(33,1);f%(x%+1,y%+1);" "
' PRINT AT(33,2);ff%(x%+1,y%+1);" "
'
UNTIL k%
IF x%<sc3% OR x%>sc4%
GOTO mausin
ENDIF
IF y%<sc5% OR y%>sc6%
GOTO mausin
ENDIF
'
mausex:
'
' PRINT x%;" ";y%
RETURN
' -------------------------
> PROCEDURE joy
joyin:
x%=sx%
y%=sy%
'
feuer%=STRIG(1)
IF feuer%=TRUE
GOTO joyex
ENDIF
'
richtung%=STICK(1)
SELECT richtung%
CASE 4
DEC x%
fa%=1
CASE 8
INC x%
fa%=2
CASE 2
INC y%
fa%=5
CASE 1
DEC y%
fa%=4
ENDSELECT
IF x%=sx% AND y%=sy%
GOTO joyin
ENDIF
joyex:
RETURN
' -------------------------
> PROCEDURE hoch
' -----
w2%=f%(zx%,zy%) !1 FELD DANACH
w3%=f%(zx%,zy%-1) !2 FELD DANACH
IF w2%<2 OR w3%=m2% !WAND
GOTO hochex !KEIN LAUFEN
ENDIF
' -----
IF w2%=m2% AND w3%>1 !KISTE UND EXTRAFELD ODER LAUFEN
w4%=ff%(zx%,zy%) !KISTENFELD
IF w4%=m2% !AUCH KISTE WEG DAMIT
ff%(zx%,zy%)=m1% !NUN LAUFFELD
ENDIF
ELSE
GOTO hochex
ENDIF
PUT sx%*ax%,sy%*ay%,bil$(ff%(sx%+1,sy%+1)) !FELD ALTE POSITION
PUT x%*ax%,y%*ay%,fahr$(fa%) !SPIELFIGUR
PUT x%*ax%,(y%-1)*ay%,bil$(m2%) !KISTE
f%(zx%,zy%-1)=m2% !DA STEHT SIE NUN
f%(zx%,zy%)=ff%(zx%,zy%)
sx%=x%
sy%=y%
hochex:
RETURN
' -------------------------
> PROCEDURE runter
' -----
w2%=f%(zx%,zy%) !1 FELD DANACH
w3%=f%(zx%,zy%+1) !2 FELD DANACH
IF w2%<2 OR w3%=m2% !WAND
GOTO rraus !KEIN LAUFEN
ENDIF
' -----
IF w2%=m2% AND w3%>1 !KISTE UND EXTRAFELD ODER LAUFEN
w4%=ff%(zx%,zy%) !KISTENFELD
IF w4%=m2% !AUCH KISTE WEG DAMIT
ff%(zx%,zy%)=m1% !NUN LAUFFELD
ENDIF
ELSE
GOTO rraus
ENDIF
PUT sx%*ax%,sy%*ay%,bil$(ff%(sx%+1,sy%+1)) !FELD ALTE POSITION
PUT x%*ax%,y%*ay%,fahr$(fa%) !SPIELFIGUR
PUT x%*ax%,(y%+1)*ay%,bil$(m2%) !KISTE
f%(zx%,zy%+1)=m2% !DA STEHT SIE NUN
f%(zx%,zy%)=ff%(zx%,zy%)
sx%=x%
sy%=y%
rraus:
RETURN
' -------------------------
> PROCEDURE links
' -----
w2%=f%(zx%,zy%) !1 FELD DANACH
w3%=f%(zx%-1,zy%) !2 FELD DANACH
IF w2%<2 OR w3%=m2% !WAND
GOTO linksex !KEIN LAUFEN
ENDIF
' -----
IF w2%=m2% AND w3%>1 !KISTE UND EXTRAFELD ODER LAUFEN
w4%=ff%(zx%,zy%) !KISTENFELD
IF w4%=m2% !AUCH KISTE WEG DAMIT
ff%(zx%,zy%)=m1% !NUN LAUFFELD
ENDIF
ELSE
GOTO linksex
ENDIF
PUT sx%*ax%,sy%*ay%,bil$(ff%(sx%+1,sy%+1)) !FELD ALTE POSITION
PUT x%*ax%,y%*ay%,fahr$(fa%) !SPIELFIGUR
PUT (x%-1)*ax%,y%*ay%,bil$(m2%) !KISTE
f%(zx%-1,zy%)=m2% !DA STEHT SIE NUN
f%(zx%,zy%)=ff%(zx%,zy%)
sx%=x%
sy%=y%
linksex:
RETURN
' -------------------------
> PROCEDURE rechts
' -----
w2%=f%(zx%,zy%) !1 FELD DANACH
w3%=f%(zx%+1,zy%) !2 FELD DANACH
IF w2%<2 OR w3%=m2% !WAND
GOTO rechtsex !KEIN LAUFEN
ENDIF
' -----
IF w2%=m2% AND w3%>1 !KISTE UND EXTRAFELD ODER LAUFEN
w4%=ff%(zx%,zy%) !KISTENFELD
IF w4%=m2% !AUCH KISTE WEG DAMIT
ff%(zx%,zy%)=m1% !NUN LAUFFELD
ENDIF
ELSE
GOTO rechtsex
ENDIF
PUT sx%*ax%,sy%*ay%,bil$(ff%(sx%+1,sy%+1)) !FELD ALTE POSITION
PUT x%*ax%,y%*ay%,fahr$(fa%) !SPIELFIGUR
PUT (x%+1)*ax%,y%*ay%,bil$(m2%) !KISTE
f%(zx%+1,zy%)=m2% !DA STEHT SIE NUN
f%(zx%,zy%)=ff%(zx%,zy%)
sx%=x%
sy%=y%
rechtsex:
RETURN
'
PROCEDURE zeit
zei$=MID$(TIME$,4,5)
PRINT AT(33,4);CHR$(27)+"c";+5;zei$;" ";CHR$(27)+"c";0
RETURN
'
> PROCEDURE siege
STICK 0
SPUT screen$
INC level%
IF score%>high%
high%=score%
hoch%=1
ENDIF
'
DEFFILL 9
'
total%=188
FOR i%=1 TO level%
PBOX 224,total%-3,228,total%-1
SUB total%,4
NEXT i%
'
'
PRINT AT(4,16);player$
PRINT AT(4,18);"nächste Etage ist ";level%
PRINT AT(4,20);"SCORE ";score%
PRINT AT(4,21);"HIGHSCORE ";high%
PAUSE 20
REPEAT
UNTIL MOUSEK
RETURN
> PROCEDURE high
CLOSE #1
n$=player$
play$=STR$(high%)
nn$=" "
RSET nn$=play$
' -------------------------------------
OPEN "R",#1,"A:\SCHIEBER\EINS.RAD",30
FIELD #1,15 AS n$,15 AS nn$
PUT #1,platz%
CLOSE #1
'
RETURN
'
' -------------------------
PROCEDURE laden
fox%=EXIST("A:\SCHIEBER\LEVEL"+STR$(level%)+".FLD")
IF fox%=0
level%=1
ENDIF
' -----
CLOSE #1
' -----
OPEN "I",#1,"A:\SCHIEBER\LEVEL"+STR$(level%)+".FLD"
' -----
INPUT #1,fx% !GROESSE
INPUT #1,fy%
INPUT #1,xmax%
INPUT #1,ymax%
' -----
ERASE f%()
ERASE ff%()
ERASE fff%()
' -----
DIM f%(fx%,fy%)
DIM ff%(fx%,fy%)
DIM fff%(fx%,fy%)
' -----
FOR i%=1 TO fx%
FOR ii%=1 TO fy%
INPUT #1,q1%
DEC q1%
f%(i%,ii%)=q1%
ff%(i%,ii%)=q1%
fff%(i%,ii%)=q1%
NEXT ii%
NEXT i%
CLOSE #1
' -----
SUB fx%,2
SUB fy%,2
xx%=xmax% DIV fx%
yy%=ymax% DIV fy%
'
IF anzeige%=0
GOTO ladenex
ENDIF
OPEN "R",#1,"A:\SCHIEBER\ZWEI.RAD",5
FIELD #1,5 AS passy$
GET #1,level%
CLOSE #1
PRINT AT(4,23);"PASSWORT IST ";passy$
PAUSE 20
REPEAT
UNTIL STRIG(1)=TRUE
'
' -----
' -------------------------
COLOR 0
y1%=100
y2%=100
FOR i%=1 TO 100
LINE 0,y1%,240,y1%
LINE 0,y2%,240,y2%
INC y2%
DEC y1%
NEXT i%
' -----
' -------------------------
x%=0
y%=0
' -----
FOR i%=1 TO fy%
FOR ii%=1 TO fx%
' -----
q1%=f%(ii%,i%)
IF q1%=3
q1%=7
ENDIF
'
'
PUT x%,y%,bil$(q1%)
ADD x%,xx%
NEXT ii%
ADD y%,yy%
x%=0
NEXT i%
' -----
x%=0
y%=0
' -----
FOR i%=1 TO fy%
FOR ii%=1 TO fx%
' -----
q1%=f%(ii%,i%)
IF q1%=3
'
PUT x%,y%,bil$(q1%)
GOSUB sou2
'
ENDIF
'
ADD x%,xx%
NEXT ii%
ADD y%,yy%
x%=0
NEXT i%
' -----
ladenex:
altlevel%=level%
RETURN
' -------------------------
> PROCEDURE neues
' -----
FOR i%=1 TO fx%
FOR ii%=1 TO fy%
q1%=fff%(i%,ii%)
f%(i%,ii%)=q1%
ff%(i%,ii%)=q1%
NEXT ii%
NEXT i%
' -----
'
COLOR 0
y1%=100
y2%=100
FOR i%=1 TO 100
LINE 0,y1%,240,y1%
LINE 0,y2%,240,y2%
INC y2%
DEC y1%
NEXT i%
' -----
' -------------------------
x%=0
y%=0
' -----
FOR i%=1 TO fy%
FOR ii%=1 TO fx%
' -----
q1%=f%(ii%,i%)
IF q1%=3
q1%=7
ENDIF
'
'
PUT x%,y%,bil$(q1%)
ADD x%,xx%
NEXT ii%
ADD y%,yy%
x%=0
NEXT i%
' -----
x%=0
y%=0
' -----
FOR i%=1 TO fy%
FOR ii%=1 TO fx%
' -----
q1%=f%(ii%,i%)
IF q1%=3
'
PUT x%,y%,bil$(q1%)
GOSUB sou2
'
ENDIF
'
ADD x%,xx%
NEXT ii%
ADD y%,yy%
x%=0
NEXT i%
RETURN
' ----------------------
> PROCEDURE bilo
DIM bil$(8)
DIM fahr$(5)
'
FOR i%=1 TO 8
CLOSE #1
OPEN "i",#1,"A:\SCHIEBER\ART\test"+STR$(i%)+".qim"
bil$(i%)=INPUT$((LOF(#1)),#1)
CLOSE #1
NEXT i%
FOR i%=1 TO 5
CLOSE #1
OPEN "i",#1,"a:\SCHIEBER\ART\fahr"+STR$(i%)+".qim"
fahr$(i%)=INPUT$((LOF(#1)),#1)
CLOSE #1
NEXT i%
RETURN
'
> PROCEDURE pic1 !eventuell ein degasbild laden ???
'
CLOSE #1
OPEN "i",#1,"A:\SCHIEBER\ART\PASS.PI1"
farb$=SPACE$(34) !originalfarben des bildes laden
BGET #1,VARPTR(farb$),34 !und in string farb$ ablegen
z%=0
FOR i%=3 TO LEN(farb$) STEP 2 !jeweils 2 werte ergeben die farbe
farb1$=MID$(farb$,i%) !wert 1
farb2$=MID$(farb$,i%+1) !wert 2
a%=ASC(farb1$) !ascii code
b%=ASC(farb2$) !asci code
c%=a%*256+b% !wandeln in farbcode
SETCOLOR z%,c% !in die farbregister damit
INC z% !hilfszahler
NEXT i%
BGET #1,XBIOS(3),32000
CLOSE #1
RETURN
> PROCEDURE pic2 !eventuell ein degasbild laden ???
'
CLOSE #1
OPEN "i",#1,"A:\SCHIEBER\ART\SCHIEBER.PI1"
farb$=SPACE$(34) !originalfarben des bildes laden
BGET #1,VARPTR(farb$),34 !und in string farb$ ablegen
z%=0
FOR i%=3 TO LEN(farb$) STEP 2 !jeweils 2 werte ergeben die farbe
farb1$=MID$(farb$,i%) !wert 1
farb2$=MID$(farb$,i%+1) !wert 2
a%=ASC(farb1$) !ascii code
b%=ASC(farb2$) !asci code
c%=a%*256+b% !wandeln in farbcode
SETCOLOR z%,c% !in die farbregister damit
INC z% !hilfszahler
NEXT i%
BGET #1,XBIOS(3),32000
CLOSE #1
RETURN
> PROCEDURE pic3 !eventuell ein degasbild laden ???
'
CLOSE #1
OPEN "i",#1,"A:\SCHIEBER\ART\OVER.PI1"
farb$=SPACE$(34) !originalfarben des bildes laden
BGET #1,VARPTR(farb$),34 !und in string farb$ ablegen
z%=0
FOR i%=3 TO LEN(farb$) STEP 2 !jeweils 2 werte ergeben die farbe
farb1$=MID$(farb$,i%) !wert 1
farb2$=MID$(farb$,i%+1) !wert 2
a%=ASC(farb1$) !ascii code
b%=ASC(farb2$) !asci code
c%=a%*256+b% !wandeln in farbcode
SETCOLOR z%,c% !in die farbregister damit
INC z% !hilfszahler
NEXT i%
BGET #1,XBIOS(3),32000
CLOSE #1
RETURN
' ----------------------
> PROCEDURE gfa1
SHOWM
STICK 0
SETCOLOR 0,7,7,7
SETCOLOR 15,0
CLS
PRINT AT(1,1);"EIN FEHLER IST AUFGETRETEN"
PRINT AT(1,2);ERR$(ERR)
'
VOID INP(2)
EDIT
RETURN
' ----------------------
> PROCEDURE gfa2
STICK 0
SHOWM
SETCOLOR 0,7,7,7
SETCOLOR 15,0
CLS
PRINT AT(1,1);"STOP DURCH BREAK"
PRINT "FREE BYTES ";FRE(9)
'
VOID INP(2)
EDIT
RETURN
' ----------------------
zu:
DATA 259,44,283,44,259,61,283,61
'
> PROCEDURE sou1
SOUND 0,0,0,0,0
WAVE 0,0
'
FOR ii%=1 TO 3
FOR i%=1 TO 8
SOUND 1,15,i%,3,1
SOUND 2,12,8,4,1
WAVE 3 !+30*256,2,13,2500*i%,3
PAUSE 1
SOUND 0,0,0,0,0
NEXT i%
NEXT ii%
GOSUB sou2
RETURN
> PROCEDURE sou2
FOR t%=15 DOWNTO 0
SOUND 1,t%,5,1
SOUND 2,t%,12,2
SOUND 3,t%,5,4
WAVE 7
FOR d%=0 TO 1000
NEXT d%
SOUND 3,t%,5,5
FOR d%=0 TO 1000
NEXT d%
NEXT t%
RETURN
> PROCEDURE sou3
WAVE 0,0
FOR iii%=0 TO 1
RESTORE sdat
FOR iiii%=1 TO 10
READ ton%
WAVE 7
SOUND 1,15,ton%,6+iii%,2
SOUND 2,13,ton%,4,1
SOUND 3,14,ton%+1,2,1
PAUSE 1.5
NEXT iiii%
NEXT iii%
GOSUB sou2
RETURN
sdat:
DATA 4,5,8,8,3,6,8,6,9,8
sdat1:
DATA 1,5,6,8,10,12
' ----------------------
> PROCEDURE sort
'
nana%=0
IF high%>hi%(7)
hi$(7)=player$
hi%(7)=high%
ENDIF
' ------
na:
nu%=0
FOR i%=1 TO 6
'
IF hi%(i%)<hi%(i%+1)
' PRINT i%;" ";
q1%=hi%(i%)
q2%=hi%(i%+1)
a$=hi$(i%)
b$=hi$(i%+1)
hi%(i%)=q2%
hi%(i%+1)=q1%
hi$(i%)=b$
hi$(i%+1)=a$
nu%=1
nana%=1
ENDIF
' EXIT IF nu%=1
'
NEXT i%
IF nu%=1
GOTO na
ENDIF
' ----------------------
IF nana%=1
hi%(7)=hi%(6)
CLOSE #1
OPEN "O",#1,"A:\SCHIEBER\HIGH"
FOR i%=1 TO 12
PRINT #1,hi$(i%)
NEXT i%
FOR i%=1 TO 12
q1%=hi%(i%)
WRITE #1,q1%
NEXT i%
CLOSE #1
ENDIF
' ---------------
FOR i%=1 TO 6
PRINT AT(4,14+i%);hi$(i%)
PRINT AT(24,14+i%);hi%(i%)
NEXT i%
RETURN